perm filename READY.F4[LCS,MUS] blob
sn#007384 filedate 1971-12-30 generic text, type T, neo UTF8
00100 SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
00200 C UNIT GEN. 'READ' = - READ(SOURCE,QUANT,ARRAY,INPUT NCHNS);
00300 C OUTPUTS ARE RDA, RDB, RDC AND RDD. DON'T USE U1, ETC.
00400 C IF SOURCE<100 IT =4TH LETTER. E.G. 4 WILL READ FROM MUSDA (4=D)
00500 C IF SOURCE>100, LAST 2 DIGITS ARE LAST LETTER, 1ST 2 ARE 4TH LETTER.
00600 C E.G. 312 WILL READ FROM MUSCL (3=C, 12=L). 1213 = MUSLM
00700 C LOAD AFTER MUSX,MUSIO,NSCTAP
00800 C MUSIO SHOULD INCLUDE MTA1 CALLS.
00900
01000 COMMON ISAVE
01100 DIMENSION IOUT(2128),XOUT(512),IX(128),IH(5)
01200 DATA IH(1)/' REA'/,IH(2)/'DING '/,IH(4)/' / '/
01300 EQUIVALENCE(IOUT(2001),IX),(K,IH(5))
01400 IF(FOOGY)GO TO 1
01500 KSIZE=LSIZE/2
01600 C KSIZE IS NUM OF 36-BIT WORDS TO PROCESS.
01700 NAME='MUSAA'
01800 JMP=-1
01900 ISAVE=-1
02000 MTA=0
02100 JA=1
02200 JNM='AAAAA'
02300 K=QUANT-1.
02400 JC=0
02500 IF(SOURCE.LT.100.)GO TO 4
02600 NAME=SOURCE/100.
02700 C GETS # FOR 1ST LETTER.
02800 JC=SOURCE-NAME*100
02900 IF(JC.NE.0)JC=JC-1
03000 C GETS 2ND LETTER.
03100 JNM=NAME-1
03200 GO TO 10
03300 4 IF(SOURCE.GT.0)GO TO 2
03400 MTA=-1
03500 JNM=NAME
03600 CC** CALL MTA1
03700 GO TO 3
03800 2 JNM=SOURCE-1.
03900 10 JNM='MUSAA'+256*JNM
04000 3 KNM=JNM
04100 NAME=JNM+JC*2
04150 JC=K*2
04200 NM2=NAME+JC
04210 JADD=JNM+52-NAME
04220 IF(JC.GT.JADD)NM2=JNM+256+JC-JADD
04240 C IF NAME GOES FROM AZ TO BA
04260 712 IF(NM2.GT.JNM+308)NM2=JNM+512+JC-52-JADD
04290 C IF NAME GOES FROM AZ TO CA
04300 IF(K.GT.26)NM2=NAME+256+(K-26)*2
04400 C AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
04500 710 IF(MTA)GO TO 811
04600 711 CALL GETFI2(NAME)
04700 IH(3)=NAME
04800 CALL MESS(IH)
04900 GO TO 810
05000 811 CONTINUE
05100 CC**811 CALL INMTA1(IX(1),128)
05200 CC** IF(IX(1))GO TO 1201
05300 GO TO 2022
05400 810 CALL FASTI2(IX(1),128)
05500 KCNT=2
05600 2022 JSC=IX(1)
05700 JADD=JSC/128
05800 IF(JSC-JADD*128.NE.0)JADD=JADD+1
05900 C JADD IS # OF 128 WD. RECORDS READ.
06000 1022 IF(JA.GT.KSIZE)GO TO 17
06100 610 IF(MTA)GO TO 611
06200 CALL FASTI2(IOUT(JA),JSC)
06300 KCNT=KCNT+JADD
06400 GO TO 612
06500 C LAST WORD IS THROWN AWAY.
06600 611 CONTINUE
06700 CC**614 CALL MTA1
06800 CC**611 CALL INMTA1(IX(JA),JSC)
06900 612 JA=JA+JSC-1
07000 JC=IOUT(JA)
07100 IF(JC)5,1022,6
07200 5 JA=JA-IOUT(JA-1)
07300 6 NAME=NAME+2
07400 IF(NAME.LE.JNM+50)GO TO 27
07500 JNM=JNM+256
07600 C RAISES 'AAAZA' TO 'AABAA'
07700 1017 NAME=JNM
07800 27 IF(NAME.LE.NM2)GO TO 710
07900 1201 NM2=NAME-1
08000 17 CALL ZBIT(IOUT,XOUT)
08100 9 RETURN
08200 1 IF(ISAVE)GO TO 171
08300 ISAVE=-1
08400 IF(NAME.GT.NM2)GO TO 171
08500 CC** IF(MTA)GO TO 614
08600 C CANNOT START UP MTA1 AGAIN IF TAPE IS MOVED.
08700 CALL GETFI2(NAME)
08800 CALL USETI(KCNT)
08900 C*** NOT YET FIXED FOR READING MAGTAPE!!!
09000 171 JC=JA-1
09100 IF(JMP)7,8,9
09200 7 JC=JC-KSIZE
09300 DO 12 K=1,JC
09400 12 IOUT(K)=IOUT(K+KSIZE)
09500 JA=JC+1
09600 IF(JC.GT.KSIZE)GO TO 17
09700 IF(NAME.LE.NM2)GO TO 610
09800 43 DO 13 K=JC+1,KSIZE
09900 13 IOUT(K)=0
10000 JMP=0
10100 GO TO 17
10200 8 DO 14 K=1,KSIZE
10300 14 IOUT(K)=0
10400 JMP=1
10500 GO TO 17
10600 END
10700 CC
10800 CC
10900 CC NCHNS←2;SRATE←25000;
11000 CC COMPILE;INSTRUMENT XX;
11100 CC READ(P3,P4,F1,P5);OUTA←OUTA+RDB;<CHAN2 DATA IS PUT IN BOTH CHANS.
11200 CC OUTB←OUTB+RDB*P6;END;FINISH;
11300 CC BIGBIT←2;
11400 CC PLAY;XX 0 3 4 3 2 2;FINISH;< MULTS SAMPLES BY 2 IN CH2, READS MUSPA, STEREO
11500
11600 CC LOA %DMUSY,NSCTPY,READIN,MUSIO↔C 14↔S↔DSK:NOTEY↔